unit GrammarTree;

interface

uses
  FormalGrammars,
  ComCtrls,
  Classes,
  SysUtils;

type
  TGrammarTreeNode = class(TTreeNode)
  private
    fLexeme: ILexeme;
  public
    property Lexeme: ILexeme read fLexeme;
  end;
  
  TGrammarTreeView = class(TTreeView)
  strict private
    fLexeme: ILexeme;
    procedure SetLexeme(const Value: ILexeme);
    procedure RebuildTree;
    function GetSelectedLexeme: ILexeme;
  protected
    function CreateNode: TTreeNode; override;
  public
    procedure ExpandUnLabeled;
    property Lexeme: ILexeme read fLexeme write SetLexeme;
    property SelectedLexeme: ILexeme read GetSelectedLexeme;
  end;

procedure Register;

implementation

{ TGrammarTreeView }

function TGrammarTreeView.CreateNode: TTreeNode;
begin
  Result := TGrammarTreeNode.Create(Items);
end;

procedure Register;
begin
  RegisterComponents('Grammars', [TGrammarTreeView]);
end;

procedure TGrammarTreeView.ExpandUnLabeled;

  procedure _ExRec(const ln: TGrammarTreeNode);
  var
    i: Integer;
  begin
    if ln.Lexeme.GetLabel = L_NONE then
    begin
      ln.Expand(False);
      for i := 0 to ln.Count - 1 do
        _ExRec(TGrammarTreeNode(ln[i]));
    end;
  end;

begin
  FullCollapse;
  if Assigned(TopItem) then
    _ExRec(TGrammarTreeNode(TopItem));
end;

function TGrammarTreeView.GetSelectedLexeme: ILexeme;
var
  n: TTreeNode;
begin
  n := Selected;
  if Assigned(n) then
    Result := TGrammarTreeNode(n).Lexeme
  else
    Result := nil;
end;

procedure TGrammarTreeView.RebuildTree;
var
  ll: ILexemeWrapper;
  recList: TList;

  procedure BuildItemRec(const n: TTreeNode; const l: ILexeme);
  var
    ls: ILexeme;
  begin
    if recList.IndexOf(Pointer(l)) >= 0 then
      Exit;

    recList.Add(Pointer(l));
    TGrammarTreeNode(n).fLexeme := l;
    if Supports(l, ILexemeWrapper, ll)  then
    begin
      ls := ILexemeWrapper(ll).GetSubLexeme;
      BuildItemRec(Items.AddChild(n, ls.ToString), ls);
    end
    else if Supports(l, ILexemeOwner, ll) then
    begin
      for ls in ILexemeOwner(ll).GetSubLexemes do
      begin
        BuildItemRec(Items.AddChild(n, ls.ToString), ls);
      end;
    end;
    recList.Remove(Pointer(l));
  end;

begin
  Items.Clear;
  if Assigned(fLexeme) then
  begin
    recList := TList.Create;
    try
      BuildItemRec(Items.AddChildFirst(nil, fLexeme.ToString), fLexeme);
    finally
      recList.Free;
    end;
  end;
end;

procedure TGrammarTreeView.SetLexeme(const Value: ILexeme);
begin
  fLexeme := Value;
  RebuildTree;
end;

end.
